home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / e_to_l / fbuilder / delphi / demos / dbexprfm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  8.6 KB  |  314 lines
  1. { FormulaBuilder Demo           }
  2. { YGB Software, Inc.            }
  3. { Copyright 1995 Clayton Collie }
  4. { All rights reserved           }
  5.  
  6. {*                                   *}
  7. {* This unit implements a Database   *}
  8. {* Expression Builder, somewhat like *}
  9. {* the one included in dBase 5.0     *}
  10. {*                                   *}
  11. unit Dbexprfm;
  12. interface
  13. uses
  14.   fbCalc,FBComp,FBDBComp,
  15.   WinTypes, WinProcs, Classes, Graphics, Forms, Controls,
  16.   StdCtrls, DBTables, DB, Buttons, ExtCtrls;
  17.  
  18. type
  19.   TDBExprBuilder = class(TForm)
  20.     BitBtn1: TBitBtn;
  21.     BitBtn2: TBitBtn;
  22.     GroupButton: TBitBtn;
  23.     SpeedButton1: TSpeedButton;
  24.     NeBtn: TSpeedButton;
  25.     LtBtn: TSpeedButton;
  26.     SpeedButton4: TSpeedButton;
  27.     LEBtn: TSpeedButton;
  28.     GeBtn: TSpeedButton;
  29.     PlusBtn: TSpeedButton;
  30.     MinusBtn: TSpeedButton;
  31.     SpeedButton9: TSpeedButton;
  32.     DivideBtn: TSpeedButton;
  33.     SpeedButton11: TSpeedButton;
  34.     QuoteBtn: TSpeedButton;
  35.     AndBtn: TSpeedButton;
  36.     OrBtn: TSpeedButton;
  37.     NotBtn: TSpeedButton;
  38.     SpeedButton16: TSpeedButton;
  39.     Bevel1: TBevel;
  40.     ExpressionMemo: TMemo;
  41.     Label1: TLabel;
  42.     Bevel4: TBevel;
  43.     Calcbtn: TBitBtn;
  44.     StatusPanel: TPanel;
  45.     GroupBox1: TGroupBox;
  46.     Resultmemo: TMemo;
  47.     Label4: TLabel;
  48.     TableGroup: TGroupBox;
  49.     TableListbox: TListBox;
  50.     FieldsGroup: TGroupBox;
  51.     FieldListbox: TListBox;
  52.     FunctionGroup: TGroupBox;
  53.     FunctionListBox: TListBox;
  54.     procedure FieldListboxDblClick(Sender: TObject);
  55.     procedure SpeedButton1Click(Sender: TObject);
  56.     procedure GroupButtonClick(Sender: TObject);
  57.     procedure TableListboxClick(Sender: TObject);
  58.     procedure FormCreate(Sender: TObject);
  59.     procedure CalcbtnClick(Sender: TObject);
  60.     procedure FunctionListBoxDblClick(Sender: TObject);
  61.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  62.     procedure FormActivate(Sender: TObject);
  63.     procedure ExpressionMemoMouseUp(Sender: TObject; Button: TMouseButton;
  64.       Shift: TShiftState; X, Y: Integer);
  65.   Private
  66.     fExpression : TDBExpression;
  67.     fDatabase   : TDatabase;
  68.     Procedure setDatabase(db : TDatabase);
  69.     procedure setExpression(const S : TDBExpression);
  70.     function  getDatabase : TDatabase;
  71.     Procedure LoadFieldListBox;
  72.     Function  Evaluate(var vtype : datatypes;var res : integer): String;
  73.   public
  74.     property Database   : TDatabase read getDatabase write setDatabase;
  75.     property Expression : TDBExpression  read fExpression write setExpression;
  76.   end;
  77.  
  78. var
  79.   DBExprBuilder: TDBExprBuilder;
  80.  
  81.  
  82. {* Allows the user to visually construct an expression based on    *}
  83. {* a BDE database. Returns TRUE if a valid expression was entered, *}
  84. {* FALSE otherwise. If false, the original expression text is      *}
  85. {* restored to the TDBExpression instance.                         *}
  86. {*                                                                 *}
  87. {* Possible improvement - Pass in a set to limit the types of      *}
  88. {* expressions permitted.                                          *}
  89. {*                                                                 *}
  90.  
  91. Function BuildDBExpression(const theTitle    : string;
  92.                            var   Expr        : TDBExpression):boolean;
  93.  
  94. implementation
  95. uses sysutils,fbMisc;
  96. {$R *.DFM}
  97.  
  98.  
  99.  
  100. Function BuildDBExpression(const theTitle    : string;
  101.                            var   Expr        : TDBExpression):boolean;
  102. Var Form1    : TDbExprBuilder;
  103.     origExpr : pchar;
  104. begin
  105.   result  := False;
  106.   Application.CreateForm(TDBExprBuilder,Form1);
  107.   origExpr := Expr.StrFormula;
  108.   Try
  109.     form1.Expression := Expr;
  110.     form1.Caption    := theTitle;
  111.     Result           := form1.ShowModal = mrOk;
  112.     if not result then
  113.        Expr.StrFormula := OrigExpr;
  114.   finally
  115.     Form1.Free;
  116.     StrDispose(OrigExpr);
  117.   end;
  118. end;
  119.  
  120.  
  121. Function TDBExprBuilder.Evaluate(var vtype : datatypes;var res : integer) : String;
  122. var tmp : string;
  123.     tptr : pchar;
  124. begin
  125.   {}tmp := ExpressionMemo.Text;
  126.   fExpression.Lines := ExpressionMemo.Lines;
  127.   if fExpression.Status = EXPR_SUCCESS then
  128.   begin
  129.     Result := fExpression.asString;
  130.     res    := fExpression.Status;
  131.     if res = EXPR_SUCCESS then
  132.        vtype := fExpression.ReturnType;
  133.   end;
  134. end; {}
  135.  
  136.  
  137. Procedure TDBExprBuilder.setExpression(const s : TDBExpression);
  138. begin
  139.   if not Assigned(s) then exit;
  140.   fExpression := s;
  141.   SetDatabase(S.Database);
  142.   ExpressionMemo.Lines.Clear;
  143.   ExpressionMemo.Lines := S.Lines;
  144. end;
  145.  
  146.  
  147. Function  TDBExprBuilder.getDatabase : TDatabase;
  148. begin
  149.   result := fDatabase;
  150. end;
  151.  
  152. Procedure TDBExprBuilder.SetDatabase( db : TDatabase);
  153. var i      : integer;
  154.     fdataset : TDataset;
  155.     tblname   : TFilename;
  156.  
  157. begin
  158.   FieldListbox.Clear;
  159.   TableListBox.Clear;
  160.   fDatabase := db;
  161.   if db = NIL then exit; {?????}
  162.   for i := 0 to db.datasetCount-1 do
  163.   begin
  164.     fDataset := db.datasets[i];
  165.     if (fDataset is TQuery) then
  166.         tblName := (fDataset as TQuery).Name
  167.       else
  168.         if (fDataset is TTable) then
  169.           tblName := JustFilename( TTable(fDataset).TableName)
  170.          else
  171.            tblName := '';
  172.     if (tblName <> '') then
  173.       TableListBox.Items.Add(TblName);
  174.   end;
  175.   if (TableListBox.Items.Count > 0) then
  176.   begin
  177.     TableListBox.ItemIndex := 0;
  178.     LoadFieldListbox;
  179.   end;
  180. end;
  181.  
  182.  
  183. procedure TDBExprBuilder.FieldListboxDblClick(Sender: TObject);
  184. var
  185.    tblname,fldname : string[50];
  186.    indx            : integer;
  187.  
  188. begin
  189.   indx := TableListBox.ItemIndex;
  190.   if indx = -1 then exit;
  191.   tblName := JustFilename(TableListBox.Items[Indx]);
  192.   indx := FieldListBox.ItemIndex;
  193.   if indx = -1 then exit;
  194.   FldName := FieldListBox.Items[Indx];
  195.   ExpressionMemo.SelText := '['+tblname+'->'+fldname+']';
  196. end;
  197.  
  198. procedure TDBExprBuilder.SpeedButton1Click(Sender: TObject);
  199. var s : string[15];
  200. begin
  201.    if (sender is TSpeedButton) then
  202.    begin
  203.       s := (sender as TSpeedbutton).Caption;
  204.       if (S[1] = '&') then
  205.          Delete(s,1,1);
  206.       ExpressionMemo.selText := ' '+s+' ';
  207.    end;
  208. end;
  209.  
  210. procedure TDBExprBuilder.GroupButtonClick(Sender: TObject);
  211. var txt : string;
  212. begin
  213.    txt := ExpressionMemo.SelText;
  214.    if txt <> '' then
  215.    ExpressionMemo.Seltext := '(' + txt + ')';
  216. end;
  217.  
  218. Procedure TDBExprBuilder.LoadFieldListBox;
  219. var fDataset : TDataset;
  220.     i        : integer;
  221. begin
  222.   FieldListbox.Clear;
  223.   i := TableListBox.ItemIndex;
  224.   if (i < 0) or (Database = NIL) then exit;
  225.   fDataset := Database.Datasets[i];
  226.   fDataset.GetFieldNames(FieldListbox.Items);
  227. end;
  228.  
  229. procedure TDBExprBuilder.TableListboxClick(Sender: TObject);
  230. begin
  231.   LoadFieldListBox;
  232. end;
  233.  
  234.  
  235. procedure TDBExprBuilder.FormCreate(Sender: TObject);
  236. var thelist : TStringList;
  237. begin
  238.   thelist := getFunctionPrototypes(false);
  239.   FunctionListBox.Items.AddStrings(thelist);
  240.   thelist.free;
  241. end;
  242.  
  243. procedure TDBExprBuilder.CalcbtnClick(Sender: TObject);
  244. var s     : string;
  245.     vtype : Datatypes;
  246.     res   : integer;
  247.  
  248. begin
  249.   s := Evaluate(vType,res);
  250.   resultMemo.Text := s;
  251.   if res <> EXPR_SUCCESS then
  252.   begin
  253.      StatusPanel.Caption := 'Expression Error : '+FExpression.StatusText;
  254.      MessageBeep(MB_ICONHAND);
  255.    end
  256.   else
  257.    StatusPanel.Caption := DataTypeName(vtype);
  258. end;
  259.  
  260.  
  261.  
  262. procedure TDBExprBuilder.FunctionListBoxDblClick(Sender: TObject);
  263. var fnName : string;
  264.     sel    : string;
  265.     indx   : integer;
  266.     p      : byte;
  267. begin
  268.   indx := FunctionListBox.ItemIndex;
  269.   if indx = -1 then exit;
  270.   FnName := FunctionListBox.Items[Indx];
  271.   p := Pos('(',fnName);
  272.   if p > 0 then
  273.      fnName := Copy(fnName,1,p-1);
  274.   fnName := fnName + '( ';
  275.   sel := ExpressionMemo.SelText;
  276.   if sel <> '' then
  277.      ExpressionMemo.SelText := fnName + Sel + ' )'
  278.    else
  279.      ExpressionMemo.SelText := fnName+' )';
  280. end;
  281.  
  282. procedure TDBExprBuilder.FormCloseQuery(Sender: TObject;var CanClose: Boolean);
  283. begin
  284.   if (modalResult = mrCancel) then
  285.       canclose := true
  286.     else
  287.       if (ModalResult = mrOk) then
  288.       begin
  289.         fExpression.Lines := ExpressionMemo.Lines;
  290.         canClose  := fExpression.Status = EXPR_SUCCESS;
  291.         if not CanClose then
  292.         begin
  293.           StatusPanel.Caption := 'Error : '+FExpression.StatusText;
  294.           MessageBeep(mb_iconHand);
  295.         end;
  296.       end;
  297. end; { FormCloseQuery }
  298.  
  299.  
  300. procedure TDBExprBuilder.FormActivate(Sender: TObject);
  301. begin
  302.    GroupButton.Enabled := False;
  303. end;
  304.  
  305.  
  306. {* Enable the Group Button only if text is highlighted *}
  307. procedure TDBExprBuilder.ExpressionMemoMouseUp(Sender: TObject;
  308.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  309. begin
  310.   GroupButton.Enabled := ExpressionMemo.selText <> '';
  311. end;
  312.  
  313. end.
  314.